Aminet 30/Aminet 30 (1999)(Schatztruhe)[!][Apr 1999].iso/Aminet/dev/lang/SmallEiffel.lha/SmallEiffel/lib_std/dictionary.e

Text File | 1998-12-22 | 15KB | 642 lines

-- This file is  free  software, which  comes  along  with  SmallEiffel. This
-- software  is  distributed  in the hope that it will be useful, but WITHOUT
-- ANY  WARRANTY;  without  even  the  implied warranty of MERCHANTABILITY or
-- FITNESS  FOR A PARTICULAR PURPOSE. You can modify it as you want, provided
-- this header is kept unaltered, and a notification of the changes is added.
-- You  are  allowed  to  redistribute  it and sell it, alone or as a part of
-- another product.
--          Copyright (C) 1994-98 LORIA - UHP - CRIN - INRIA - FRANCE
--            Dominique COLNET and Suzanne COLLIN - [e-mail]
--                       http://www.loria.fr/SmallEiffel
--
class DICTIONARY[V,K->HASHABLE]
   --
   -- Associative memory.
   -- Values of type `V' are stored using Keys of type `K'.
   --

inherit
   ANY
      redefine is_equal, copy
      end;

creation make, with_capacity

feature

   Default_size: INTEGER is 32;
     -- Minimum size for storage in muber of items.

feature {DICTIONARY}

   keys: FIXED_ARRAY[K];
     -- Storage for keys of type `K'.

   store: FIXED_ARRAY[V];
     -- Storage for values of type `V'.

   modulus: INTEGER;
     -- To compute a hash value in range [0 .. `modulus'-1].

   buckets: FIXED_ARRAY[INTEGER];
     -- Valid index range is always [0 .. `modulus'-1].
     -- Contents is a hash code value in range [0 .. `keys.upper'] to
     -- acess `keys', `store' and `chain' as well.

   chain: FIXED_ARRAY[INTEGER];
     -- Used to chain both free slots and hash-code clash.
     -- Value -1 mark the end of a list.

   first_free_slot: INTEGER;
     -- First element of the free-slot list or -1 when no more
     -- free slot are available.

feature {DICTIONARY}  -- Internal cache handling :

   cache_keys_idx: INTEGER;
     -- Contents is -1 or caches the last visited entry using : `has',
     -- `at', `item', or `key'.

   cache_user_idx: INTEGER;
     -- Contents is -1 or in range [1 .. `count']. When not -1, it
     -- caches the last user's index used with `item' or `key'.

   cache_buckets_idx: INTEGER;
     -- Contents means nothing when `cache_user_idx' is -1.
     -- Otherwise, gives the current position in `buckets' during
     -- traversal.

feature {NONE}

   buckets_keys_ratio: INTEGER is 3;
     -- To compute `modulus' as `ratio' * `capacity'.

feature {NONE}

   make is
     -- Internal initial storage size of the dictionary is set to
     -- the default `Default_size' value. Then, tuning of needed storage
     -- size is done automatically according to usage.
     -- If you are really sure that your dictionary is always really
     -- bigger than `Default_size', you may use `with_capacity' to save some
     -- execution time.
      do
     with_capacity(Default_size);
      ensure
     empty;
     capacity = Default_size
      end;

   with_capacity(medium_size: INTEGER) is
     -- May be used to save some execution time if one is sure
     -- that storage size will rapidly become really bigger than
     -- `Default_size'. When first `remove' occurs, storage size may
     -- naturally become smaller than `medium_size'. Afterall,
     -- tuning of storage size is done automatically according to
     -- usage.
      require
     medium_size > 0
      local
     i: INTEGER;
      do
     !!keys.make(medium_size);
     !!store.make(medium_size);
     modulus := buckets_keys_ratio * medium_size;
     !!buckets.make(modulus);
     buckets.set_all_with(-1);
     from
        !!chain.make(medium_size);
        i := chain.upper;
        first_free_slot := i;
     until
        i < 0
     loop
        chain.put(i - 1, i);
        i := i - 1;
     end;
     cache_keys_idx := -1;
     cache_user_idx := -1;
     count := 0;
      ensure
     empty;
     capacity = medium_size
      end;

feature -- Counting :

   count: INTEGER;
     -- Actual `count' of stored elements.

   empty: BOOLEAN is
      do
     Result := count = 0;
      ensure
     Result = (count = 0)
      end;

feature -- Basic access :

   has(k: K): BOOLEAN is
     -- Is there an item currently associated with key `k' ?
      do
     if cache_keys_idx < 0 or else
        not k.is_equal(keys.item(cache_keys_idx))
      then
        cache_user_idx := -1;
        from
           cache_keys_idx := buckets.item(k.hash_code \\ modulus);
        until
           cache_keys_idx < 0 or else
           k.is_equal(keys.item(cache_keys_idx))
        loop
           cache_keys_idx := chain.item(cache_keys_idx);
        end;
     end;
     Result := (cache_keys_idx >= 0);
      end;

   at, infix "@" (k: K): V is
     -- Return the item stored at key `k'.
      require
     has(k)
      do
     if cache_keys_idx < 0 or else
        not k.is_equal(keys.item(cache_keys_idx))
      then
        cache_user_idx := -1;
        from
           cache_keys_idx := buckets.item(k.hash_code \\ modulus);
        until
           k.is_equal(keys.item(cache_keys_idx))
        loop
           cache_keys_idx := chain.item(cache_keys_idx);
        end;
     end;
     Result := store.item(cache_keys_idx);
      end;

feature -- The only way to add or to change an entry :

   put(v: V; k: K) is
     -- If there is as yet no key `k' in the dictionary, enter
     -- it with item `v'. Otherwise overwrite the item associated
     -- with key `k'.
      local
     h: INTEGER;
      do
     if cache_keys_idx < 0 or else
        not k.is_equal(keys.item(cache_keys_idx))
      then
        cache_user_idx := -1;
        from
           h := k.hash_code \\ modulus;
           cache_keys_idx := buckets.item(h);
        until
           cache_keys_idx < 0 or else
           k.is_equal (keys.item (cache_keys_idx))
        loop
           cache_keys_idx := chain.item (cache_keys_idx);
        end;
        if cache_keys_idx < 0 then
           if first_free_slot < 0 then
          expand;
          h := k.hash_code \\ modulus;
           end;
           keys.put(k,first_free_slot);
           store.put(v,first_free_slot);
           cache_keys_idx := first_free_slot;
           first_free_slot := chain.item(first_free_slot);
           chain.put(buckets.item(h),cache_keys_idx);
           buckets.put(cache_keys_idx,h);
           count := count + 1;
        else
           store.put(v,cache_keys_idx);
        end;
     else
        store.put(v,cache_keys_idx);
     end;
      ensure
     v = at(k)
      end;

feature -- Looking and Searching :

   nb_occurrences(v: V): INTEGER is
     -- Number of occurrences using `equal'.
     -- See also `fast_nb_occurrences' to chose
     -- the apropriate one.
      local
     i: INTEGER;
      do
     from
        i := 1
     until
        i > count
     loop
        if equal_like(v,item(i)) then
           Result := Result + 1;
        end;
        i := i + 1;
     end;
      ensure
     Result >= 0
      end;

   fast_nb_occurrences(v: V): INTEGER is
     -- Number of occurrences using `='.
      local
     i: INTEGER;
      do
     from
        i := 1
     until
        i > count
     loop
        if v = item(i) then
           Result := Result + 1;
        end;
        i := i + 1;
     end;
      ensure
     Result >= 0;
      end;

   key_at(v: V): K is
     -- Retrieve the key used for value `v' using `equal' for comparison.
      require
     nb_occurrences(v) = 1
      local
     i: INTEGER;
      do
     from
        i := 1;
     until
        equal_like(v,item(i))
     loop
        i := i + 1;
     end;
     Result := keys.item(cache_keys_idx);
      ensure
     equal(at(Result),v)
      end;

   fast_key_at(v: V): K is
     -- Retrieve the key used for value `v' using `=' for comparison.
      require
     fast_nb_occurrences(v) = 1
      local
     i: INTEGER;
      do
     from
        i := 1;
     until
        v = item(i)
     loop
        i := i + 1;
     end;
     Result := keys.item(cache_keys_idx);
      ensure
     at(Result) = v
      end;

   capacity: INTEGER is
      do
     Result := keys.count;
      end;

feature -- Removing :

   remove(k: K) is
      local
     h, keys_idx, keys_next_idx: INTEGER;
      do
     h := k.hash_code \\ modulus;
     keys_idx := buckets.item(h);
     if keys_idx < 0 then
     elseif keys.item(keys_idx).is_equal(k) then
        buckets.put(chain.item(keys_idx),h);
        chain.put(first_free_slot,keys_idx);
        first_free_slot := keys_idx;
        cache_user_idx := -1;
        cache_keys_idx := -1;
        count := count - 1;
     else
        from
           keys_next_idx := chain.item(keys_idx);
        until
           keys_next_idx < 0 or else
           keys.item(keys_next_idx).is_equal(k)
           loop
          keys_idx := keys_next_idx;
          keys_next_idx := chain.item(keys_next_idx);
           end;
           if keys_next_idx >= 0 then
          chain.put(chain.item(keys_next_idx),keys_idx);
          chain.put(first_free_slot,keys_next_idx);
          first_free_slot := keys_next_idx;
          cache_user_idx := -1;
          cache_keys_idx := -1;
          count := count - 1;
           end;
        end;
      ensure
     not has(k)
      end;

   clear is
     -- Discard all items.
      local
     i: INTEGER;
      do
     buckets.set_all_with(-1);
     from
        i := chain.upper;
        first_free_slot := i;
     until
        i < 0
     loop
        chain.put(i - 1, i);
        i := i - 1;
     end;
     cache_keys_idx := -1;
     cache_user_idx := -1;
     count := 0;
      ensure
     empty;
      end;

feature -- To provide iterating facilities :

   lower: INTEGER is 1;

   upper: INTEGER is
      do
     Result := count;
      ensure
     Result = count
      end;

   valid_index(idx: INTEGER): BOOLEAN is
      do
     Result := (1 <= idx) and then (idx <= count);
      ensure
     Result =  (1 <= idx and then idx <= count);
      end;

   item(idx: INTEGER): V is
      require
     valid_index(idx)
      do
     set_cache_user_idx(idx);
     Result := store.item(cache_keys_idx);
      ensure
     Result = at(key(idx))
      end;

   key(idx: INTEGER): K is
      require
     valid_index(idx)
      do
     set_cache_user_idx(idx);
     Result := keys.item(cache_keys_idx);
      ensure
     at(Result) = item(idx)
      end;

feature

   is_equal(other: like current): BOOLEAN is
      local
     buckets_idx, keys_idx: INTEGER;
     k: K;
     v1, v2: V;
      do
     if Current = other then
        Result := true;
     elseif count = other.count then
        from
           Result := true;
           buckets_idx := 0;
        until
           not Result or else buckets_idx > buckets.upper
        loop
           keys_idx := buckets.item(buckets_idx);
           if keys_idx >= 0 then
          from
          until
             not Result or else keys_idx < 0
          loop
             k := keys.item(keys_idx);
             if other.has(k) then
            v1 := store.item(keys_idx);
            v2 := other.at(k);
            Result := equal_like(v1,v2);
             else
            Result := false;
             end;
             keys_idx := chain.item(keys_idx);
          end;
           end;
           buckets_idx := buckets_idx + 1;
        end;
     end;
      end;

   copy(other: like current) is
      do
     count := other.count;
     modulus := other.modulus;
     first_free_slot := other.first_free_slot;
     cache_keys_idx := other.cache_keys_idx;
     cache_user_idx := other.cache_user_idx;
     cache_buckets_idx := other.cache_buckets_idx;
     if buckets = Void then
        buckets := other.buckets.twin;
        keys := other.keys.twin;
        store := other.store.twin;
        chain := other.chain.twin;
     else
        buckets.copy(other.buckets);
        keys.copy(other.keys);
        store.copy(other.store);
        chain.copy(other.chain);
     end;
      end;

feature {NONE}

   expand is
     -- The dictionary must grow.
      local
     i: INTEGER;
      do
     from
        i := keys.count;
        resize_buckets(i * 2 * buckets_keys_ratio);
     until
        i = 0
     loop
        chain.add_last(first_free_slot);
        first_free_slot := chain.upper;
        i := i - 1;
     end;
     keys.resize(chain.count);
     store.resize(chain.count);
      ensure
     first_free_slot >= 0
      end;

   resize_buckets(new_modulus: INTEGER) is
      local
     h, i: INTEGER;
      do
     modulus := new_modulus;
     buckets.resize(new_modulus);
     buckets.set_all_with(-1);
     from
     until
        first_free_slot < 0
     loop
        i := chain.item(first_free_slot);
        chain.put(-2,first_free_slot);
        first_free_slot := i;
     end;
     check
        first_free_slot = -1;
     end;
     from
        i := chain.upper;
     until
        i < 0
     loop
        if chain.item(i) = -2 then
           chain.put(first_free_slot,i);
           first_free_slot := i;
        else
           h := keys.item(i).hash_code \\ new_modulus;
           chain.put(buckets.item(h),i);
           buckets.put(i,h);
        end;
        i := i - 1;
     end;
      end;

feature {NONE}

   equal_like(v1, v2: V): BOOLEAN is
     -- Note: to avoid calling `equal' :-(
     -- Because SmallEiffel is not yet able to infer
     -- arguments types.
      do
     if v1.is_expanded_type then
        Result := v1 = v2 or else v1.is_equal(v2);
     elseif v1 = v2 then
        Result := true;
     elseif v1 = Void or else v2 = Void then
     else
        Result := v1.is_equal(v2);
     end;
      end;

feature {NONE}

   set_cache_user_idx(idx: INTEGER) is
      require
     valid_index(idx)
      local
     i: INTEGER;
      do
     if idx = cache_user_idx + 1 then
        cache_user_idx := idx;
        if chain.item(cache_keys_idx) < 0 then
           from
          cache_buckets_idx := cache_buckets_idx + 1;
           until
          buckets.item(cache_buckets_idx) >= 0
           loop
          cache_buckets_idx := cache_buckets_idx + 1;
           end;
           cache_keys_idx := buckets.item(cache_buckets_idx);
        else
           cache_keys_idx := chain.item(cache_keys_idx);
        end;
     elseif idx = cache_user_idx - 1 then
        cache_user_idx := idx;
        if cache_keys_idx = buckets.item(cache_buckets_idx) then
           from
          cache_buckets_idx := cache_buckets_idx - 1;
           until
          buckets.item(cache_buckets_idx) >= 0
           loop
          cache_buckets_idx := cache_buckets_idx - 1;
           end;
           from
          cache_keys_idx := buckets.item(cache_buckets_idx);
           until
          chain.item(cache_keys_idx) < 0
           loop
          cache_keys_idx := chain.item(cache_keys_idx);
           end;
        else
           from
          i := buckets.item(cache_buckets_idx);
           until
          chain.item(i) = cache_keys_idx
           loop
          i := chain.item(i);
           end;
           cache_keys_idx := i;
        end;
     elseif idx = cache_user_idx then
     elseif idx = 1 then
        cache_user_idx := 1;
        from
           cache_buckets_idx := 0;
        until
           buckets.item(cache_buckets_idx) >= 0
        loop
           cache_buckets_idx := cache_buckets_idx + 1;
        end;
        cache_keys_idx := buckets.item(cache_buckets_idx);
     elseif idx = count then
        cache_user_idx := idx;
        from
           cache_buckets_idx := buckets.upper;
        until
           buckets.item(cache_buckets_idx) >= 0
        loop
           cache_buckets_idx := cache_buckets_idx - 1;
        end;
        from
           cache_keys_idx := buckets.item(cache_buckets_idx);
        until
           chain.item(cache_keys_idx) < 0
        loop
           cache_keys_idx := chain.item(cache_keys_idx);
        end;
     else
        from
           set_cache_user_idx(1);
        until
           cache_user_idx = idx
        loop
           set_cache_user_idx(cache_user_idx + 1);
        end;
     end;
      ensure
     cache_user_idx = idx;
     buckets.valid_index(cache_buckets_idx);
     keys.valid_index(cache_keys_idx);
      end;

invariant

   (keys.upper = store.upper) and (store.upper = chain.upper);

   buckets.upper = modulus - 1;

   -1 <= first_free_slot and first_free_slot <= chain.upper;

end -- DICTIONARY[V,K->HASHABLE]